home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rdblib / rbscrn.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  3.2 KB  |  92 lines
  1. VERSION 2.00
  2. Begin Form RBScrn 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Current Screen Print"
  5.    ClientHeight    =   4020
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1485
  8.    ClientWidth     =   7365
  9.    ControlBox      =   0   'False
  10.    Height          =   4425
  11.    HelpContextID   =   39
  12.    Left            =   1035
  13.    LinkTopic       =   "Form2"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    MousePointer    =   11  'Hourglass
  17.    ScaleHeight     =   4020
  18.    ScaleWidth      =   7365
  19.    Top             =   1140
  20.    Width           =   7485
  21.    WindowState     =   2  'Maximized
  22.    Begin PictureBox Picture1 
  23.       AutoRedraw      =   -1  'True
  24.       BorderStyle     =   0  'None
  25.       Height          =   4035
  26.       Left            =   0
  27.       ScaleHeight     =   4035
  28.       ScaleWidth      =   7395
  29.       TabIndex        =   0
  30.       Top             =   0
  31.       Visible         =   0   'False
  32.       Width           =   7395
  33.    End
  34. Dim ljunk As Integer
  35. Sub Form_Activate ()
  36.     mousepointer = HOURGLASS
  37.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_HIDE)
  38.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_HIDE)
  39.     ljunk = ShowWindow(RBScrn.hWnd, SW_HIDE)
  40.     DoEvents
  41.     mousepointer = HOURGLASS
  42.     GrabScreen
  43.     mousepointer = HOURGLASS
  44.     ljunk = ShowWindow(RBScrn.hWnd, SW_SHOW)
  45.     RBScrn.WindowState = MAXIMIZED
  46.     DoEvents
  47.     RBScrn.PrintForm
  48.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_SHOW)
  49.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_SHOW)
  50.     Unload RBScrn
  51. End Sub
  52. Sub GetTwipsPerPixel ()
  53.     ' Set a global variable with the Twips to Pixel ratio.
  54.     RBScrn.ScaleMode = 3
  55.     NumPix = RBScrn.ScaleHeight
  56.     RBScrn.ScaleMode = 1
  57.     TwipsPerPixel = RBScrn.ScaleHeight / NumPix
  58. End Sub
  59. Sub GrabScreen ()
  60.     Dim winSize As lrect
  61.     ' Assign information of the source bitmap.
  62.     ' Note that BitBlt requires coordinates in pixels.
  63.     hwndSrc% = GetDesktopWindow()
  64.     hSrcDC% = GetDC(hwndSrc%)
  65.     XSrc% = 0: YSrc% = 0
  66.     Call GetWindowRect(hwndSrc%, winSize)
  67.     nWidth% = winSize.right             ' Units in pixels.
  68.     nHeight% = winSize.bottom           ' Units in pixels.
  69.     ' Assign informate of the destination bitmap.
  70.     hDestDC% = RBScrn.Picture1.hDC
  71.     x% = 0: Y% = 0
  72.     ' Set global variable TwipsPerPixel and use to set
  73.     ' picture box to same size as screen being grabbed.
  74.     ' If picture box not the same size as picture being
  75.     ' BitBlt'ed to it, it will chop off all that does not
  76.     ' fit in the picture box.
  77.     GetTwipsPerPixel
  78.     RBScrn.Picture1.Top = 0
  79.     RBScrn.Picture1.Left = 0
  80.     RBScrn.Picture1.Width = (nWidth% + 1) * TwipsPerPixel
  81.     RBScrn.Picture1.Height = (nHeight% + 1) * TwipsPerPixel
  82.     ' Assign the value of the constant SRCOPYY to the Raster operation.
  83.     dwRop& = &HCC0020
  84.     ' Note function call must be on one line:
  85.     Suc% = BitBlt(hDestDC%, x%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)
  86.     ' Release the DeskTopWindow's hDC to Windows.
  87.     ' Windows may hang if this is not done.
  88.     Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)
  89.     'Make the picture box visible.
  90.     RBScrn.Picture1.Visible = True
  91. End Sub
  92.